MacWorld 1998 February/Macworld (1998-02).dmg/Control Strip Modules/DuoDepth1.0b1/Source/DuoDepth.p

Text File | 1995-07-07 | 7KB | 236 lines

unit DuoDepth;
(*
# Copyright Quinn "The Eskimo!"
# Created : Quinn
# Station : Eriodon
# Date : Friday, 7 July 1995
*)
interface

    uses
        Types,
        ControlStrip,
        GestaltEqu,
        Resources,
        Displays,
        Icons,
        ToolUtils;

    type
        myGlobals =
            record
                popup_menu : MenuHandle;
                main_icon : Handle;
                arrow_picture : PicHandle;
                help_string : Str255;
            end;
        myGlobalsPtr = ^myGlobals;
        myGlobalsHandle = ^myGlobalsPtr;

    function Main(message : longint;
                              globals : myGlobalsHandle;
                              statusRect : RectPtr;
                              statusPort : GrafPtr) : longint;

implementation


    const
         kMyModuleWidth = 26;
         kBaseDisplayMode = 128;            (* base sRsrc *)
         (* Normally you'd find this out by walking the Slot Manager data structures
                  but I'm too lazy so I'm hardwiring this for the Duo 280c.  This is why
                 this module does a check for specific hardware. Also it assumes you're
                 not docked and using some other video device as the main device. Altogether
                 very skanky but it works for *my* Duo, and that's what counts.
         *)

         (* MENU *)
         rPopupMenu = 256;

         iThousandsColours = 1;
         i256Colours = 2;

         (* STR  *)
         rHelpString = 256;

         (* ics# *)
         rMainIcon = 256;

         (* PICT *)
         rArrowPicture = 256;

    function Main(message : longint;
                              globals : myGlobalsHandle;
                              statusRect : RectPtr;
                              statusPort : GrafPtr) : longint;

        procedure CleanGlobals(tmp_globals : myGlobalsHandle);
            var
                junk : OSErr;
        begin
            if tmp_globals^^.popup_menu <> nil then begin
                DisposeHandle(Handle(tmp_globals^^.popup_menu));
                tmp_globals^^.popup_menu := nil;
            end; (* if *)
            if tmp_globals^^.arrow_picture = nil then begin
                KillPicture(tmp_globals^^.arrow_picture);
                tmp_globals^^.arrow_picture:= nil;
            end; (* if *)
            if tmp_globals^^.main_icon = nil then begin
                junk := DisposeIconSuite(tmp_globals^^.main_icon, true);
                tmp_globals^^.main_icon:= nil;
            end; (* if *)
        end; (* CleanGlobals *)

        function InitModule : longint;
            var
                err : OSErr;
                new_globals : myGlobalsHandle;
                response : longint;
        begin
            new_globals := nil;
            err := Gestalt(gestaltMachineType, response);
            if (err = noErr) & (response <> gestaltPowerBookDuo280c) then begin
                err := -1;
            end; (* if *)
            (* create and init my globals *)
            if err = noErr then begin
                new_globals := myGlobalsHandle(NewHandle(sizeof(myGlobals)));
                err := MemError;
            end; (* if *)
            if err = noErr then begin
                HLock(Handle(new_globals));
                new_globals^^.popup_menu := nil;
                new_globals^^.help_string := GetString(rHelpString)^^;
                new_globals^^.popup_menu := GetMenu(rPopupMenu);
                if new_globals^^.popup_menu = nil then begin
                    err := resNotFound;
                end else begin
                    DetachResource(Handle(new_globals^^.popup_menu));
                end; (* if *)
            end; (* if *)
            if err = noErr then begin
                err := SBGetDetachIconSuite(new_globals^^.main_icon, rMainIcon, svAllSmallData);
            end; (* if *)
            if err = noErr then begin
                new_globals^^.arrow_picture := GetPicture(rArrowPicture);
                if new_globals^^.arrow_picture = nil then begin
                    err := resNotFound;
                end else begin
                    DetachResource(Handle(new_globals^^.arrow_picture));
                end; (* if *)
            end; (* if *)
            (* setup the result *)
            if err = noErr then begin
                HUnlock(Handle(new_globals));
                InitModule := longint(new_globals);
            end else begin
                CleanGlobals(new_globals);
                if new_globals <> nil then begin
                    DisposeHandle(Handle(new_globals));
                end; (* if *)
                InitModule := longint(err);
            end; (* if *)
        end; (* InitModule *)

        function CloseModule : longint;
        begin
            (* clean my globals *)
            CleanGlobals(globals);
            (* dispose my globals *)
            DisposeHandle(Handle(globals));
            CloseModule := 0;        (* ControlStrip doesn't care what we return *)
        end; (* CloseModule *)

        function DrawStatus : longint;
            var
                plot_rect : Rect;
                junk : OSErr;
        begin
            (* draw the main icon *)
            plot_rect.topLeft := statusRect^.topLeft;
            plot_rect.right := plot_rect.left + 16;
            plot_rect.bottom := plot_rect.top + 16;
            junk := PlotIconSuite(plot_rect, atNone, ttNone, globals^^.main_icon);
            (* draw the arrow *)
            plot_rect := globals^^.arrow_picture^^.picFrame;
            OffsetRect(plot_rect, -plot_rect.left, -plot_rect.top);
            OffsetRect(plot_rect, statusRect^.left + 16, statusRect^.top);
            OffsetRect(plot_rect, 0, (statusRect^.bottom - plot_rect.bottom) div 2); (* sneaky way to centre vertically *)
            DrawPicture(globals^^.arrow_picture, plot_rect);
            DrawStatus := 0;        (* ControlStrip doesn't care what we return *)
        end; (* DrawStatus *)

        function MouseClick : longint;
            var
                err : OSErr;
                menu_item : integer;
                video_depth_long : longint;
                main_device : GDHandle;
                currently_small : boolean;
        begin
            main_device := GetMainDevice;
            (* Yucky assumption here!  If the screen height is less than 480 pixels *)
            (*  then we're in 640 x 400, else we're in 640 x 480. *)
            currently_small := (main_device^^.gdRect.bottom - main_device^^.gdRect.top) < 480;
            if currently_small then begin
                SetItemMark(globals^^.popup_menu, iThousandsColours, '•');
                SetItemMark(globals^^.popup_menu, i256Colours, ' ');
            end else begin
                SetItemMark(globals^^.popup_menu, iThousandsColours, ' ');
                SetItemMark(globals^^.popup_menu, i256Colours, '•');
            end; (* if *)
            menu_item := SBTrackpopupMenu(statusRect^, globals^^.popup_menu);
            if menu_item <> 0 then begin
                video_depth_long := 32;        (* request maximum bit depth for the mode *)
                err := DMSetDisplayMode(main_device,
                                        menu_item - 1 + kBaseDisplayMode,
                                        video_depth_long,
                                        0,
                                        nil);
                if err <> noErr then begin
                    DebugStr('Error setting mode.');
                end; (* if *)
            end; (* if *)
            MouseClick := 0;    (* same bits as sdevPeriodicTickle *)
        end; (* MouseClick *)

        function ShowBalloonHelp : longint;
            var
                tmpstr : Str255;
        begin
            tmpstr := globals^^.help_string;
            ShowBalloonHelp := SBShowHelpString(statusRect^, @tmpstr);
        end; (* ShowBalloonHelp *)

        var
            result : longint;
    begin
        case message of
            sdevInitModule:
                result := InitModule;
            sdevCloseModule:
                result := CloseModule;
            sdevFeatures:
                result := bsl(1, sdevWantMouseClicks)
                                        + bsl(1, sdevDontAutoTrack)
                                        + bsl(1, sdevHasCustomHelp);
            sdevGetDisplayWidth:
                result := kMyModuleWidth;
            sdevPeriodicTickle:
                result := 0;
            sdevDrawStatus:
                result := DrawStatus;
            sdevMouseClick:
                result := MouseClick;
            sdevShowBalloonHelp:
                result := ShowBalloonHelp;
        otherwise
            result := 0;
        end; (* case *)
        Main := result;
    end; (* Main *)

end. (* DuoDepth *)